Private Sub Command1_Click()

' Save a copy of the doc as PDF and JPEG and then save as a Photoshop file with options.

Dim appRef As Photoshop.Application
Dim docRef As Photoshop.Document
Dim numDocs As Long
Dim extType As Photoshop.PsExtensionType

Set appRef = New Photoshop.Application
numDocs = appRef.Documents.Count
extType = psUppercase

If (numDocs > 0) Then

    Set docRef = appRef.Documents(1)
    
    ' save the doc as PDF
    Dim pdfSaveOptions As Photoshop.pdfSaveOptions
    Set pdfSaveOptions = New Photoshop.pdfSaveOptions
    pdfSaveOptions.AlphaChannels = True
    pdfSaveOptions.Annotations = True
    pdfSaveOptions.EmbedColorProfile = True
    pdfSaveOptions.EmbedFonts = True
    pdfSaveOptions.Encoding = psPDFJPEG
    pdfSaveOptions.Interpolation = False
    pdfSaveOptions.JPEGQuality = 7
    pdfSaveOptions.Layers = True
    pdfSaveOptions.SpotColors = True
    pdfSaveOptions.Transparency = False
    pdfSaveOptions.UseOutlines = False
    pdfSaveOptions.VectorData = True
    docRef.SaveAs "c:\temp\myFile", Options:=pdfSaveOptions, asCopy:=True, extensionType:=extType
    
    ' now save as JPEG
    Dim jpgSaveOptions As Photoshop.JPEGSaveOptions
    Set jpgSaveOptions = New Photoshop.JPEGSaveOptions
    jpgSaveOptions.EmbedColorProfile = True
    jpgSaveOptions.FormatOptions = psStandardBaseline
    jpgSaveOptions.Matte = psNoMatte
    jpgSaveOptions.Quality = 1
    docRef.SaveAs "c:\temp\myFile", Options:=jpgSaveOptions, asCopy:=True, extensionType:=extType
    
    ' now save as photoshop with extra options.
    Dim psSaveOptions As Photoshop.PhotoshopSaveOptions
    Set psSaveOptions = New Photoshop.PhotoshopSaveOptions
    psSaveOptions.AlphaChannels = True
    psSaveOptions.Annotations = True
    psSaveOptions.Layers = True
    psSaveOptions.SpotColors = True
    docRef.SaveAs "c:\temp\myFile", Options:=psSaveOptions, asCopy:=False, extensionType:=extType

Else
    MsgBox ("There must be at least one open document")
End If

End Sub

